home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1996 September / Software of the Month Club 1996 September.iso / mac / Software Research Institute-SRI / Business / Alpha ƒ / Tcl / SystemCode / c.tcl < prev    next >
Encoding:
Text File  |  1995-12-14  |  11.1 KB  |  402 lines  |  [TEXT/ALFA]
  1.  
  2. newModeVar C elecColon {1} 1
  3. newModeVar C elecRBrace {1} 1
  4. newModeVar C leftFillColumn {3} 0
  5. newModeVar C prefixString {//} 0 
  6. newModeVar C electricSemi {1} 1
  7. newModeVar C wordBreak {[a-zA-Z0-9_]+} 0
  8. newModeVar C elecLBrace {1} 1
  9. newModeVar C elecElse {1} 1
  10. newModeVar C wordWrap {0} 1
  11. newModeVar C funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  12. newModeVar C wordBreakPreface {[^a-zA-Z0-9_]} 0
  13. newModeVar C electricTab {0} 1
  14. newModeVar C autoMark    0    1
  15.  
  16. set cCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  17. set cPreRegexp        {^\#[\t ]*[a-z]*}
  18. set    cKeyWords    {
  19.     void break register short enum extern int for if while struct static long continue
  20.     switch case char unsigned double float return else default goto do pascal Boolean
  21.     typedef volatile union auto sizeof size_t
  22. }
  23. if {[info exists Cwords]} {set cKeyWords [concat $cKeyWords $Cwords]}
  24. regModeKeywords -e {//} -b {/*} {*/} -c red -m {#} -k blue C $cKeyWords
  25. # regModeKeywords -a -u -k blue C {pete keleher}
  26. # regModeKeywords -e {//} -b {/*} {*/} -c red -m {#} -k blue C $cKeyWords -i "\}" -i "\{" -I green
  27.  
  28. #================================================================================
  29.  
  30. newModeVar C++ elecColon {1} 1
  31. newModeVar C++ elecRBrace {1} 1
  32. newModeVar C++ leftFillColumn {3} 0
  33. newModeVar C++ prefixString {//} 0
  34. newModeVar C++ electricSemi {1} 1
  35. newModeVar C++ wordBreak {[a-zA-Z0-9_]+} 0
  36. newModeVar C++ elecLBrace {1} 1
  37. newModeVar C++ elecElse {1} 1
  38. newModeVar C++ wordWrap {0} 1
  39. newModeVar C++ funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  40. newModeVar C++ wordBreakPreface {[^a-zA-Z0-9_]} 0
  41. newModeVar C++ electricTab {1} 1
  42. newModeVar C++ autoMark        0    1
  43.  
  44.  
  45. set {c++KeyWords} {
  46.     new delete class friend protected private public template 
  47.     try catch throw operator const mutable virtual asm inline this
  48.     and and_eq bitand bitor compl not or or_eq xor xor_eq not_eq
  49.     wchar_t bool true false
  50.     static_cast dynamic_cast reinterpret_cast typeid
  51.     using namespace inherited
  52. }
  53. if {[info exists {C++words}]} {
  54.     set {c++KeyWords} [concat ${c++KeyWords} ${C++words} $cKeyWords]
  55. } else {
  56.     set {c++KeyWords} [concat ${c++KeyWords} $cKeyWords]
  57. }
  58.  
  59. regModeKeywords -e {//} -b {/*} {*/} -c red -m {#} -k blue {C++} ${c++KeyWords}
  60. # regModeKeywords -e {//} -b {/*} {*/} -c red -m {#} -k blue {C++} ${c++KeyWords} -i "\{" -i "\}" -I green
  61. unset cKeyWords
  62. unset {c++KeyWords}
  63.  
  64. #=============================================================================
  65. # "Electric" C functions.
  66. #=============================================================================
  67.  
  68. # returns the indent string of the line named by 'pos'
  69. proc indentString pos {
  70.     set start [lineStart $pos]
  71.     set end [nextLineStart $pos]
  72.     set text [getText $start $end]
  73.     for {set i 0} {1} {incr i} {
  74.         set c [string index $text $i]
  75.         if {($c != "\ ") && ($c != "\t")} then {
  76.             return [string range $text 0 [expr $i-1]]
  77.         }
  78.     }
  79.     return
  80. }
  81.  
  82.  
  83. # Brace on new line, same indentation. Insert on another new line, indented in.
  84. # First, see if we are on new line.
  85. proc electricCLeft {} {
  86.     global mode
  87.     global ${mode}modeVars
  88.     deleteText [getPos] [selEnd]
  89.     if {![set ${mode}modeVars(elecLBrace)]} then {
  90.         insertText "\{"
  91.         return
  92.     }
  93.     if {[set ${mode}modeVars(elecLBrace)] && ![catch {search -l [lineStart [expr [lineStart [getPos]] - 1]] -s -f 0 -r 0 "\}" [getPos]} res]} {
  94.         if {[regexp {\}[ \t\r]*else} [getText [lindex $res 0] [expr [getPos] + 1]]]} {
  95.             set res2 [search -f 0 -r 0 {else} [getPos]]
  96.             oneSpace
  97.             set text [getText [lindex $res2 0] [getPos]]
  98.             if {[lookAt [expr [getPos] - 1]] != " "} {
  99.                 append text " "
  100.             }
  101.             replaceText [expr [lindex $res 0] + 1] [getPos] " $text\{\r"
  102.             indentLine
  103.             return
  104.         }
  105.     }
  106.     set pos [getPos]
  107.     set start [lineStart $pos]
  108.     set text [getText $start $pos]
  109.     
  110.     for {set i $start} {$i < $pos} {incr i} {
  111.         set c [lookAt $i]
  112.         if {($c != "\ ") && ($c != "\t")} then {
  113.             break;
  114.         }
  115.     }
  116.     set indentation [getText $start $i]
  117.     if {($i == $pos) || ([lookAt $pos] == " ")} {
  118.         insertText "\{\r" $indentation "\t"
  119.     } else {
  120.         insertText " \{\r" $indentation "\t"
  121.     }
  122. }
  123. bind '\{' <s> electricCLeft C
  124. bind '\{' <s> electricCLeft C++
  125.  
  126.  
  127. # Brace on new line, immediate carriage return
  128. proc electricCRight {} {
  129.     global mode
  130.     global ${mode}modeVars
  131.     
  132.     deleteText [getPos] [selEnd]
  133.     if {[set ${mode}modeVars(elecRBrace)] == "0"} then {
  134.         insertText "\}"
  135.         catch {blink [matchIt "\}" [expr [getPos]-2]]}
  136.         return
  137.     }
  138.     set pos [getPos]
  139.     set start [lineStart $pos]
  140.     
  141.     if {[catch {matchIt "\}" [expr $pos-1]} matched]} {
  142.         beep
  143.         return
  144.     }
  145.     set text [getText [lineStart $matched] $matched]
  146.     regexp {^[     ]*} $text indentation
  147.     for {set i $start} {$i < $pos} {incr i} {
  148.         set c [lookAt $i]
  149.         if {($c != "\ ") && ($c != "\t")} then {
  150.             insertText "\r" $indentation "\}\r" $indentation
  151.             blink $matched
  152.             return
  153.         }
  154.     }
  155.     set text [set indentation]\}\r$indentation
  156.     replaceText $start $pos $text
  157.     goto [expr {$start + [string length $text]}]
  158.     blink [matchIt "\}" [expr $start-2]]
  159. }
  160. bind '\}' <s> electricCRight C
  161. bind '\}' <s> electricCRight C++
  162.  
  163.  
  164. # Brace on new line, immediate carriage return. We don't do our electric stuff
  165. # if we are in the middle of a for statement.
  166. proc electricCSemi {} {
  167.     global mode
  168.     global ${mode}modeVars
  169.     deleteText [getPos] [selEnd]
  170.     if {[set ${mode}modeVars(electricSemi)] == "0"} then {
  171.         insertText ";"
  172.         return
  173.     }
  174.     set pos [getPos]
  175.     set start [lineStart $pos]
  176.     set text [getText $start $pos]
  177.     
  178.     if {[string first "for" $text] != "-1"} {
  179.         set lefts 0
  180.         set rights 0
  181.         set len [string length $text]
  182.         for {set i 0} {$i < $len} {incr i} {
  183.             case [string index $text $i] in {
  184.                 "("    { incr lefts }
  185.                 ")"    { incr rights }
  186.             }
  187.         }
  188.         global globs
  189.         set globs [list $lefts $rights $len]
  190.         if {$lefts != $rights} {
  191.             insertText ";"
  192.             return
  193.         }
  194.     }
  195.     
  196.     insertText ";\r" [indentString $pos]
  197. }
  198. bind '\;' electricCSemi C
  199. bind '\;' electricCSemi C++
  200.  
  201.  
  202. proc ordSemi {} {
  203.     insertText {;}
  204. }
  205.  
  206. bind '\;' <z> ordSemi
  207.  
  208.  
  209. proc cppCR {} {
  210.     if {[lookAt [expr [getPos] - 1]] == ":"} {
  211.         if { [lookAt [getPos]] == "\r" } {
  212.             indentLine
  213.             endOfLine
  214.             carriageReturn
  215.         } else {
  216.             set pos [getPos]
  217.             endOfLine
  218.             set t [getText $pos [getPos]]
  219.             replaceText $pos [getPos] ""
  220.             indentLine
  221.             endOfLine
  222.             carriageReturn
  223.             insertText $t
  224.         }
  225.         indentLine
  226.     } else {
  227.         carriageReturn
  228.         indentLine
  229.     }
  230.     
  231. }
  232.  
  233. bind '\r'     cppCR C
  234. bind '\r'     cppCR C++
  235.         
  236. #================================================================================
  237.  
  238. # proc CMarkFile {} {
  239. #     global CmodeVars
  240. #     set pos 0
  241. #     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $CmodeVars(funcExpr) $pos} res]} {
  242. #         set start [lindex $res 0]
  243. #         set end [expr [lindex $res 1] + 1]
  244. #         set text [getText $start $end]
  245. #         if {[regexp {([a-zA-Z0-9:_]+)[ \t]*\(} $text dummy word]} {
  246. #             set tmp [expr $start + [string first $word $text]]
  247. #             set inds($word) "$tmp [expr $tmp + [string length $word]]"
  248. #         }
  249. #         set pos $end
  250. #     }
  251. #     if {[info exists inds]} {
  252. #         foreach f [lsort -ignore [array names inds]] {
  253. #             set res $inds($f)
  254. #             setNamedMark $f [lineStart [lindex $res 0]] [lindex $res 0] [lindex $res 1]
  255. #         }
  256. #     }
  257. # }
  258. # 
  259. #     
  260. # #The previous version would not find things like     void    *ThisFunc( xxx ) due to the asterisk
  261. # #I also truncated the pattern.  The rest is not necessary and intrusive as far as I can tell   
  262. # proc C++MarkFile {} {
  263. #     set pos 0
  264. #     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 {^([^ \t\(#\r/@].*[ \t]+)?\*?([A-Za-z0-9:~_]+)[ \t\r]*\(} $pos} res]} {
  265. #         set start [lindex $res 0]
  266. #         set end [expr [lindex $res 1] + 1]
  267. #         set thistext [getText $start $end]
  268. #         #regexp doesn't like carriage returns
  269. #         regsub -all "\r" $thistext " " thistext
  270. #         #regexp doesn't like tabs either
  271. #         regsub -all "\t" $thistext " " thistext
  272. #         #if the open paren was the last character on the line the selected text included the last carriage return as well
  273. #         #trim this off now that it is changed into a space
  274. #         set thistext [string trimright $thistext]
  275. #         if {[regexp {([a-zA-Z0-9:~_]+)[ \t]*\(} $thistext dummy word]} {
  276. #             set inds($word) [lineStart [expr $start - 1]]
  277. #         }
  278. #         set pos $end
  279. #     }
  280. #     if {[info exists inds]} {
  281. #         foreach f [lsort -ignore [array names inds]] {
  282. #             set next [nextLineStart $inds($f)]
  283. #             setNamedMark $f $inds($f) $next $next
  284. #         }
  285. #     }
  286. # }
  287.  
  288.  
  289. proc CMarkFile {} {
  290.     global CmodeVars
  291.     set pos 0
  292.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $CmodeVars(funcExpr) $pos} res]} {
  293.         set start [lindex $res 0]
  294.         set end [expr [lindex $res 1] + 1]
  295.         set text [getText $start $end]
  296.         if {[regexp {([a-zA-Z0-9:_]+)[ \t]*\(} $text dummy word]} {
  297.             set tmp [expr $start + [string first $word $text]]
  298.             set inds($word) "$tmp [expr $tmp + [string length $word]]"
  299.         }
  300.         set pos $end
  301.     }
  302.  
  303.     ## 
  304.      # Also    mark any class or struct definitions
  305.      ##
  306.     
  307.     set markExpr {^(class|struct) [A-Za-z0-9_]+[ \t]*(:|\{)}
  308.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos} res]} {
  309.         set start [lindex $res 0]
  310.         set end [expr [lindex $res 1] -1]
  311.         set text [string trimright [getText $start $end] ]
  312.         set inds($text) "$start [expr $start + [string length $text]]"
  313.         set pos $end
  314.     }
  315.     if {[info exists inds]} {
  316.         foreach f [lsort -ignore [array names inds]] {
  317.             set res $inds($f)
  318.             setNamedMark $f [lineStart [lindex $res 0]] [lindex $res 0] [lindex $res 1]
  319.         }
  320.     }
  321. }
  322.  
  323. proc C++MarkFile {} {
  324.     set pos 0
  325.     set markExpr {^([^ \t\(#\r/@].*[ \t]+)?\*?([A-Za-z0-9<>~_]+::[-A-Za-z0-9~_+=\*/]+|[A-Za-z0-9~_]+)[ \t\r]*\(}
  326.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos} res]} {
  327.         set start [lindex $res 0]
  328.         set end [expr [lindex $res 1] + 1]
  329.         set thistext [getText $start $end]
  330.         #regexp doesn't like carriage returns
  331.         regsub -all "\r" $thistext " " thistext
  332.         #regexp doesn't like tabs either
  333.         regsub -all "\t" $thistext " " thistext
  334.         #if the open paren was the last character on the line the selected text 
  335.         #included the last carriage return as well
  336.         #trim this off now that it is changed into a space
  337.         set thistext [string trimright $thistext]
  338.         if {[regexp {([A-Za-z0-9<>~_]+::[-A-Za-z0-9~_+=\*/]+|[A-Za-z0-9~_]+)[ \t]*\(} $thistext dummy word]} {
  339.             if { [string first "::" $word] != -1 } {
  340.                 regsub {(<[A-Za-z0-9_]+>)?::} $word " " it
  341.                 set l [lindex $it 0]
  342.                 if { $l == [lindex $it 1] } {
  343.                     set word "Construct '$l'"
  344.                 } elseif { "~$l" == [lindex $it 1] } {
  345.                     set word "Destruct '$l'"
  346.                 }
  347.             }
  348.             set inds($word) [lineStart [expr $start - 1]]
  349.         }
  350.         set pos $end
  351.     }
  352.     if {[info exists inds]} {
  353.         foreach f [lsort -ignore [array names inds]] {
  354.             set next [nextLineStart $inds($f)]
  355.             # Alpha doesn't like '<' or '>' in the mark menu
  356.             regsub -all {[<>]+} $f "|" it
  357.             if {[string length $it] > 35} { set it "[string range $it 0 31]..." }
  358.             setNamedMark "${it}" "$inds($f)" $next $next
  359.         }
  360.     }
  361. }
  362.  
  363. proc setC++Mode {} {
  364.     changeMode "C++"
  365. }
  366.  
  367.  
  368.  
  369. source "$HOME:Tcl:SystemCode:think.tcl"
  370.  
  371. proc dummyC {} {}
  372. proc dummyC++ {} {}
  373.  
  374.  
  375. #===============================================================================
  376.  
  377. proc CDblClick {from to} {
  378.     global tagFile
  379.     
  380.     select $from $to
  381.     set text [getSelect]
  382.     
  383.     set lines [grep "^$text'" $tagFile]
  384.     if {[regexp {'(.*)'(.*[^\t])(\t)+░} $lines dummy one two]} {
  385.         if {[string match "*$one*" [winNames -f]]} {
  386.             bringToFront $one
  387.         } else {
  388.             edit $one
  389.         }
  390.         set inds [search -f 1 -r 0 "$two" 0]
  391.         display [lindex $inds 0]
  392.         eval select $inds
  393.     } else {
  394.         checkRunning ThinkReference DanR referencePath
  395.         AEBuild {'DanR'} DanR {REF } "----" "╥$text╙"
  396.     }
  397. }
  398.  
  399. proc C++DblClick {from to shift option control} {
  400.     CDblClick $from $to
  401. }
  402.